home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disc 35 / Commodore_Disc_35_19xx_-_de.d64 / magic clock (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  4KB  |  194 lines
  1. 10 rem rubics clock====================
  2. 20 rem by alfons mittelmeyer
  3. 30 rem
  4. 40 rem fuer commodore computer
  5. 50 rem c116/c16/p4/c64/c128
  6. 60 rem
  7. 70 rem beispiel fuer guten
  8. 80 rem programmierstil
  9. 90 rem ================================
  10. 100 rem rechneranpassung
  11. 110 p=peek(772)
  12. 120 rx=781*(p=124)+2035*(p=86)+7*(p=13)
  13. 130 rx=-rx:ry=rx+1:goto1860
  14. 140 :
  15. 150 rem ----------- initialisierung -----
  16. 160 rem init
  17. 170 goto200
  18. 180 :
  19. 190 rem ausgabeinit
  20. 200 yk=3:xk=9:rem rahmenposition
  21. 210 lr$=" ":zr$=chr$(18)+" "+chr$(146)
  22. 220 lf$=chr$(17):bs$=chr$(157)
  23. 230 wa$=chr$(195):se$=chr$(194):lo$=chr$(176):ro$=chr$(174)
  24. 240 lu$=chr$(173):ru$=chr$(189):si$=chr$(122):so$=chr$(113)
  25. 250 :
  26. 260 rem varinit
  27. 270 dim f(43)
  28. 280 vo=0:hi=22:ze=13:sc=0
  29. 290 sc=0:rg=4:ze=13:vo=0:hi=22
  30. 300 ec(0)=0:ec(1)=2:ec(2)=6:ec(3)=8
  31. 310 :
  32. 320 rem funktionen
  33. 330 def fn yp(n)=int(n/3)*6+yk+3
  34. 340 def fn xp(n)=(n-int(n/3)*3)*7+xk+3
  35. 350 def fn ei(i)=f(i+vo)
  36. 360 def fn zw(b)=(ec(a)+ec(b))/2
  37. 370 def fn ko(n)=abs(n+12*((n=0)or(n=13)))
  38. 380 def fn ex(n)=((i and not n)or(not i and n))
  39. 390 def fn wt(i)=(NULL)((NULL)(fnei(x),fnei(i)),1)
  40. 400 :
  41. 410 rem zeitinit
  42. 420 x=rnd(-ti)
  43. 430 a=ze+vo:fori=a to a+8:f(i)=int(rnd(1)*12+1):next
  44. 440 a=ze+hi:fori=a to a+8:f(i)=int(rnd(1)*12+1):next
  45. 450 for i=0 to 3:f(ze+hi+ec(fnex(1)))=fnko(12-f(ec(i)+ze)):next
  46. 460 :
  47. 470 rem schaltinit
  48. 480 a=sc+vo:fori=a to a+3:f(i)=0:next
  49. 490 a=sc+hi:fori=a to a+3:f(i)=1:next
  50. 500 ra=0:return
  51. 510 :
  52. 520 rem ---------- ausgaberoutinen -----
  53. 530 rem plot
  54. 540 pokerx,y:pokery,x:sys65520:return
  55. 550 :
  56. 560 rem rahmen(yo,xl,yu,xr) var h,v,i,x,y,a$,b$
  57. 570 h=xr-xl-1:v=yu-yo-1
  58. 580 y=yo:x=xl:a$=lo$:b$=ro$:gosub620:x=xr:gosub630
  59. 590 x=xl:gosub630:y=yu:a$=lu$:b$=ru$:goto620
  60. 600 :
  61. 610 rem rahmh(y,x,a$,b$), rahmv(y,x)
  62. 620 gosub540: printa$;: fori=1 to h: printwa$;:next: printb$: return
  63. 630 gosub540: for i=1 to v: printlf$se$bs$;: next: return
  64. 640 :
  65. 650 rem uhrrahmen
  66. 660 yo=yk:yu=yk+18:xl=xk:xr=xk+21:gosub570
  67. 670 for j=0 to 8:yo=fnyp(j)-1:yu=yo+2
  68. 680 xl=fnxp(j)-1:xr=xl+3:gosub570:next:return
  69. 690 :
  70. 700 rem schaltplatz(i)
  71. 710 x=xk+7+(i and 1)*7:y=yk+6+int(i/2)*6:goto540
  72. 720 :
  73. 730 rem schaltstellung
  74. 740 a$=si$:if f(i+vo+sc)=0 then a$=so$
  75. 750 printa$;:return
  76. 760 :
  77. 770 rem zeigschalter(i)
  78. 780 gosub710:goto740
  79. 790 :
  80. 800 rem schaltbild
  81. 810 for i=0 to 3: gosub780:next:return
  82. 820 :
  83. 830 rem zeigzeit
  84. 840 for i=0 to 8:x=fnxp(i):y=fnyp(i):gosub540:printright$(" "+str$(f(i+ze+vo)),2);
  85. 850 next:return
  86. 860 :
  87. 870 rem zeigrad(ra)
  88. 880 gosub940:printzr$;:return
  89. 890 :
  90. 900 rem loeschrad(ra)
  91. 910 gosub940:printlr$;:return
  92. 920 :
  93. 930 rem radplatz(i)
  94. 940 x=xk-1+(ra and 1)*23:y=yk-1+int(ra/2)*20:goto540
  95. 950 :
  96. 960 rem ----------- riegel-logik -------
  97. 970 rem einsumme(/n)
  98. 980 n=0:a=sc+vo:for i=a to a+3:n=n+f(i):next:return
  99. 990 :
  100. 1000 rem eckriegeln
  101. 1010 for a=0 to 3:i=fnei(a):i=fnex(fnei(x))
  102. 1020 f(vo+rg+ec(a))=fnex(1):next:return
  103. 1030 :
  104. 1040 rem teilriegeln
  105. 1050 gosub980:if f(x+vo)=0 then 1110
  106. 1060 :
  107. 1070 rem untfall
  108. 1080 on n goto 1260,1200,1200,1200
  109. 1090 :
  110. 1100 rem obfall
  111. 1110 on n+1 goto 1230,1230,1370,1200
  112. 1120 :
  113. 1130 rem alles(w)
  114. 1140 ad=rg+vo:for i=ad to ad+8:f(i)=w:next:return
  115. 1150 :
  116. 1160 rem riegeln
  117. 1170 x=ra:gosub1050:gosub1520:i=x:x=fnex(1):gosub1050:goto1520
  118. 1180 :
  119. 1190 rem verriegeln
  120. 1200 w=0:gosub1140:goto1010
  121. 1210 :
  122. 1220 rem entriegeln
  123. 1230 w=1:gosub1140:goto1010
  124. 1240 :
  125. 1250 rem einknopfunten
  126. 1260 gosub1230:i=x:i=fnex(3):a=i
  127. 1270 f(vo+rg+fnzw(fnex(1)))=0
  128. 1280 f(vo+rg+fnzw(fnex(2)))=0
  129. 1290 return
  130. 1300 :
  131. 1310 rem welche
  132. 1320 for i=0 to 3
  133. 1330 if fnei(i)=1 then b=a:a=i
  134. 1340 next:a=fnzw(b):return
  135. 1350 :
  136. 1360 rem zweiknopfoben
  137. 1370 gosub1230:i=x
  138. 1380 if fnei(x)<>fnei(fnex(3))thengosub1320:f(rg+vo+a)=0
  139. 1390 return
  140. 1400 :
  141. 1410 rem ------------- teilprogramme ---
  142. 1420 rem nummer
  143. 1430 x=(asc(c$)-1)and3:return
  144. 1440 :
  145. 1450 rem schalten
  146. 1460 gosub1490:goto1490
  147. 1470 :
  148. 1480 rem teilschalten(x)
  149. 1490 a=x+sc+vo:i=f(a):f(a)=fnex(1):gosub1520:i=x:x=fnex(1):return
  150. 1500 :
  151. 1510 rem wenden
  152. 1520 a=vo:vo=hi:hi=a:return
  153. 1530 :
  154. 1540 rem schaltung
  155. 1550 gosub1430:gosub1460:i=x:gosub780:goto1170
  156. 1560 :
  157. 1570 rem wendung
  158. 1580 gosub910:i=ra:ra=fnex(1):gosub880
  159. 1590 gosub1520:gosub810:goto840
  160. 1600 :
  161. 1610 rem drehen
  162. 1620 gosub1650:x=-x:goto1650
  163. 1630 :
  164. 1640 teildrehen
  165. 1650 ad=rg+vo:for i=ad to ad+8
  166. 1660 if f(i)=1 then f(i+9)=fnko(f(i+9)+x)
  167. 1670 next:goto1520
  168. 1680 :
  169. 1690 rem drehung
  170. 1700 x=1:if c$="-" then x=-1
  171. 1710 gosub1620:goto840
  172. 1720 :
  173. 1730 rem radwahl
  174. 1740 gosub910:gosub1900:gosub1430:ra=x:gosub880:goto1170
  175. 1750 :
  176. 1760 rem ------------- hauptprogramm ---
  177. 1770 rem anfang
  178. 1780 printchr$(147):gosub170:gosub660:gosub810:gosub840:gosub880:goto1170
  179. 1790 :
  180. 1800 rem tastwertung
  181. 1810 n=0:fori=1to8:ifc$=mid$("1234.+-0",i,1) then n=i:i=8
  182. 1820 next:on n goto 1550,1550,1550,1550,1740,1700,1700,1580
  183. 1830 return
  184. 1840 :
  185. 1850 rem hauptschleife
  186. 1860 gosub1780
  187. 1870 gosub1900:gosub1810:goto1870
  188. 1880 :
  189. 1890 rem eingabe
  190. 1900 get c$:if c$="" then 1900
  191. 1910 return
  192. 1920 :
  193. 1930 rem =========== e n d e ===========
  194.